home *** CD-ROM | disk | FTP | other *** search
/ Software of the Month Club 2000 October / Software of the Month - Ultimate Collection Shareware 277.iso / pc / PROGRAMS / UTILITY / WINLINUX / DATA1.CAB / usr_-_Usr_Files / BIN / S2P < prev    next >
Text File  |  1999-09-17  |  15KB  |  810 lines
  1. #!/usr/bin/perl
  2.     eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
  3.     if $running_under_some_shell;
  4. $startperl = "#!/usr/bin/perl";
  5. $perlpath = "/usr/bin/perl";
  6.  
  7. # $RCSfile: s2p.SH,v $$Revision: 4.1 $$Date: 92/08/07 18:29:23 $
  8. #
  9. # $Log:    s2p.SH,v $
  10.  
  11. =head1 NAME
  12.  
  13. s2p - Sed to Perl translator
  14.  
  15. =head1 SYNOPSIS
  16.  
  17. B<s2p [options] filename>
  18.  
  19. =head1 DESCRIPTION
  20.  
  21. I<S2p> takes a sed script specified on the command line (or from
  22. standard input) and produces a comparable I<perl> script on the
  23. standard output.
  24.  
  25. =head2 Options
  26.  
  27. Options include:
  28.  
  29. =over 5
  30.  
  31. =item B<-DE<lt>numberE<gt>>
  32.  
  33. sets debugging flags.
  34.  
  35. =item B<-n>
  36.  
  37. specifies that this sed script was always invoked with a B<sed -n>.
  38. Otherwise a switch parser is prepended to the front of the script.
  39.  
  40. =item B<-p>
  41.  
  42. specifies that this sed script was never invoked with a B<sed -n>.
  43. Otherwise a switch parser is prepended to the front of the script.
  44.  
  45. =back
  46.  
  47. =head2 Considerations
  48.  
  49. The perl script produced looks very sed-ish, and there may very well
  50. be better ways to express what you want to do in perl.  For instance,
  51. s2p does not make any use of the split operator, but you might want
  52. to.
  53.  
  54. The perl script you end up with may be either faster or slower than
  55. the original sed script.  If you're only interested in speed you'll
  56. just have to try it both ways.  Of course, if you want to do something
  57. sed doesn't do, you have no choice.  It's often possible to speed up
  58. the perl script by various methods, such as deleting all references to
  59. $\ and chop.
  60.  
  61. =head1 ENVIRONMENT
  62.  
  63. S2p uses no environment variables.
  64.  
  65. =head1 AUTHOR
  66.  
  67. Larry Wall E<lt>F<larry@wall.org>E<gt>
  68.  
  69. =head1 FILES
  70.  
  71. =head1 SEE ALSO
  72.  
  73.  perl    The perl compiler/interpreter
  74.  
  75.  a2p    awk to perl translator
  76.  
  77. =head1 DIAGNOSTICS
  78.  
  79. =head1 BUGS
  80.  
  81. =cut
  82.  
  83. $indent = 4;
  84. $shiftwidth = 4;
  85. $l = '{'; $r = '}';
  86.  
  87. while ($ARGV[0] =~ /^-/) {
  88.     $_ = shift;
  89.   last if /^--/;
  90.     if (/^-D/) {
  91.     $debug++;
  92.     open(BODY,'>-');
  93.     next;
  94.     }
  95.     if (/^-n/) {
  96.     $assumen++;
  97.     next;
  98.     }
  99.     if (/^-p/) {
  100.     $assumep++;
  101.     next;
  102.     }
  103.     die "I don't recognize this switch: $_\n";
  104. }
  105.  
  106. unless ($debug) {
  107.     open(BODY,"+>/tmp/sperl$$") ||
  108.       &Die("Can't open temp file: $!\n");
  109. }
  110.  
  111. if (!$assumen && !$assumep) {
  112.     print BODY &q(<<'EOT');
  113. :    while ($ARGV[0] =~ /^-/) {
  114. :        $_ = shift;
  115. :      last if /^--/;
  116. :        if (/^-n/) {
  117. :        $nflag++;
  118. :        next;
  119. :        }
  120. :        die "I don't recognize this switch: $_\\n";
  121. :    }
  122. :    
  123. EOT
  124. }
  125.  
  126. print BODY &q(<<'EOT');
  127. :    #ifdef PRINTIT
  128. :    #ifdef ASSUMEP
  129. :    $printit++;
  130. :    #else
  131. :    $printit++ unless $nflag;
  132. :    #endif
  133. :    #endif
  134. :    <><>
  135. :    $\ = "\n";        # automatically add newline on print
  136. :    <><>
  137. :    #ifdef TOPLABEL
  138. :    LINE:
  139. :    while (chop($_ = <>)) {
  140. :    #else
  141. :    LINE:
  142. :    while (<>) {
  143. :        chop;
  144. :    #endif
  145. EOT
  146.  
  147. LINE:
  148. while (<>) {
  149.  
  150.     # Wipe out surrounding whitespace.
  151.  
  152.     s/[ \t]*(.*)\n$/$1/;
  153.  
  154.     # Perhaps it's a label/comment.
  155.  
  156.     if (/^:/) {
  157.     s/^:[ \t]*//;
  158.     $label = &make_label($_);
  159.     if ($. == 1) {
  160.         $toplabel = $label;
  161.         if (/^(top|(re)?start|redo|begin(ning)|again|input)$/i) {
  162.         $_ = <>;
  163.         redo LINE; # Never referenced, so delete it if not a comment.
  164.         }
  165.     }
  166.     $_ = "$label:";
  167.     if ($lastlinewaslabel++) {
  168.         $indent += 4;
  169.         print BODY &tab, ";\n";
  170.         $indent -= 4;
  171.     }
  172.     if ($indent >= 2) {
  173.         $indent -= 2;
  174.         $indmod = 2;
  175.     }
  176.     next;
  177.     } else {
  178.     $lastlinewaslabel = '';
  179.     }
  180.  
  181.     # Look for one or two address clauses
  182.  
  183.     $addr1 = '';
  184.     $addr2 = '';
  185.     if (s/^([0-9]+)//) {
  186.     $addr1 = "$1";
  187.     $addr1 = "\$. == $addr1" unless /^,/;
  188.     }
  189.     elsif (s/^\$//) {
  190.     $addr1 = 'eof()';
  191.     }
  192.     elsif (s|^/||) {
  193.     $addr1 = &fetchpat('/');
  194.     }
  195.     if (s/^,//) {
  196.     if (s/^([0-9]+)//) {
  197.         $addr2 = "$1";
  198.     } elsif (s/^\$//) {
  199.         $addr2 = "eof()";
  200.     } elsif (s|^/||) {
  201.         $addr2 = &fetchpat('/');
  202.     } else {
  203.         &Die("Invalid second address at line $.\n");
  204.     }
  205.     if ($addr2 =~ /^\d+$/) {
  206.         $addr1 .= "..$addr2";
  207.     }
  208.     else {
  209.         $addr1 .= "...$addr2";
  210.     }
  211.     }
  212.  
  213.     # Now we check for metacommands {, }, and ! and worry
  214.     # about indentation.
  215.  
  216.     s/^[ \t]+//;
  217.     # a { to keep vi happy
  218.     if ($_ eq '}') {
  219.     $indent -= 4;
  220.     next;
  221.     }
  222.     if (s/^!//) {
  223.     $if = 'unless';
  224.     $else = "$r else $l\n";
  225.     } else {
  226.     $if = 'if';
  227.     $else = '';
  228.     }
  229.     if (s/^{//) {    # a } to keep vi happy
  230.     $indmod = 4;
  231.     $redo = $_;
  232.     $_ = '';
  233.     $rmaybe = '';
  234.     } else {
  235.     $rmaybe = "\n$r";
  236.     if ($addr2 || $addr1) {
  237.         $space = ' ' x $shiftwidth;
  238.     } else {
  239.         $space = '';
  240.     }
  241.     $_ = &transmogrify();
  242.     }
  243.  
  244.     # See if we can optimize to modifier form.
  245.  
  246.     if ($addr1) {
  247.     if ($_ !~ /[\n{}]/ && $rmaybe && !$change &&
  248.       $_ !~ / if / && $_ !~ / unless /) {
  249.         s/;$/ $if $addr1;/;
  250.         $_ = substr($_,$shiftwidth,1000);
  251.     } else {
  252.         $_ = "$if ($addr1) $l\n$change$_$rmaybe";
  253.     }
  254.     $change = '';
  255.     next LINE;
  256.     }
  257. } continue {
  258.     @lines = split(/\n/,$_);
  259.     for (@lines) {
  260.     unless (s/^ *<<--//) {
  261.         print BODY &tab;
  262.     }
  263.     print BODY $_, "\n";
  264.     }
  265.     $indent += $indmod;
  266.     $indmod = 0;
  267.     if ($redo) {
  268.     $_ = $redo;
  269.     $redo = '';
  270.     redo LINE;
  271.     }
  272. }
  273. if ($lastlinewaslabel++) {
  274.     $indent += 4;
  275.     print BODY &tab, ";\n";
  276.     $indent -= 4;
  277. }
  278.  
  279. if ($appendseen || $tseen || !$assumen) {
  280.     $printit++ if $dseen || (!$assumen && !$assumep);
  281.     print BODY &q(<<'EOT');
  282. :    #ifdef SAWNEXT
  283. :    }
  284. :    continue {
  285. :    #endif
  286. :    #ifdef PRINTIT
  287. :    #ifdef DSEEN
  288. :    #ifdef ASSUMEP
  289. :        print if $printit++;
  290. :    #else
  291. :        if ($printit)
  292. :        { print; }
  293. :        else
  294. :        { $printit++ unless $nflag; }
  295. :    #endif
  296. :    #else
  297. :        print if $printit;
  298. :    #endif
  299. :    #else
  300. :        print;
  301. :    #endif
  302. :    #ifdef TSEEN
  303. :        $tflag = 0;
  304. :    #endif
  305. :    #ifdef APPENDSEEN
  306. :        if ($atext) { chop $atext; print $atext; $atext = ''; }
  307. :    #endif
  308. EOT
  309.  
  310. print BODY &q(<<'EOT');
  311. :    }
  312. EOT
  313. }
  314.  
  315. unless ($debug) {
  316.  
  317.     print &q(<<"EOT");
  318. :    $startperl
  319. :    eval 'exec $perlpath -S \$0 \${1+"\$@"}'
  320. :        if \$running_under_some_shell;
  321. :    
  322. EOT
  323.     print"$opens\n" if $opens;
  324.     seek(BODY, 0, 0) || die "Can't rewind temp file: $!\n";
  325.     while (<BODY>) {
  326.     /^[ \t]*$/ && next;
  327.     /^#ifdef (\w+)/ && ((${lc $1} || &skip), next);
  328.     /^#else/ && (&skip, next);
  329.     /^#endif/ && next;
  330.     s/^<><>//;
  331.     print;
  332.     }
  333. }
  334.  
  335. &Cleanup;
  336. exit;
  337.  
  338. sub Cleanup {
  339.     unlink "/tmp/sperl$$";
  340. }
  341. sub Die {
  342.     &Cleanup;
  343.     die $_[0];
  344. }
  345. sub tab {
  346.     "\t" x ($indent / 8) . ' ' x ($indent % 8);
  347. }
  348. sub make_filehandle {
  349.     local($_) = $_[0];
  350.     local($fname) = $_;
  351.     if (!$seen{$fname}) {
  352.     $_ = "FH_" . $_ if /^\d/;
  353.     s/[^a-zA-Z0-9]/_/g;
  354.     s/^_*//;
  355.     $_ = "\U$_";
  356.     if ($fhseen{$_}) {
  357.         for ($tmp = "a"; $fhseen{"$_$tmp"}; $a++) {}
  358.         $_ .= $tmp;
  359.     }
  360.     $fhseen{$_} = 1;
  361.     $opens .= &q(<<"EOT");
  362. :    open($_, '>$fname') || die "Can't create $fname: \$!";
  363. EOT
  364.     $seen{$fname} = $_;
  365.     }
  366.     $seen{$fname};
  367. }
  368.  
  369. sub make_label {
  370.     local($label) = @_;
  371.     $label =~ s/[^a-zA-Z0-9]/_/g;
  372.     if ($label =~ /^[0-9_]/) { $label = 'L' . $label; }
  373.     $label = substr($label,0,8);
  374.  
  375.     # Could be a reserved word, so capitalize it.
  376.     substr($label,0,1) =~ y/a-z/A-Z/
  377.       if $label =~ /^[a-z]/;
  378.  
  379.     $label;
  380. }
  381.  
  382. sub transmogrify {
  383.     {    # case
  384.     if (/^d/) {
  385.         $dseen++;
  386.         chop($_ = &q(<<'EOT'));
  387. :    <<--#ifdef PRINTIT
  388. :    $printit = 0;
  389. :    <<--#endif
  390. :    next LINE;
  391. EOT
  392.         $sawnext++;
  393.         next;
  394.     }
  395.  
  396.     if (/^n/) {
  397.         chop($_ = &q(<<'EOT'));
  398. :    <<--#ifdef PRINTIT
  399. :    <<--#ifdef DSEEN
  400. :    <<--#ifdef ASSUMEP
  401. :    print if $printit++;
  402. :    <<--#else
  403. :    if ($printit)
  404. :        { print; }
  405. :    else
  406. :        { $printit++ unless $nflag; }
  407. :    <<--#endif
  408. :    <<--#else
  409. :    print if $printit;
  410. :    <<--#endif
  411. :    <<--#else
  412. :    print;
  413. :    <<--#endif
  414. :    <<--#ifdef APPENDSEEN
  415. :    if ($atext) {chop $atext; print $atext; $atext = '';}
  416. :    <<--#endif
  417. :    $_ = <>;
  418. :    chop;
  419. :    <<--#ifdef TSEEN
  420. :    $tflag = 0;
  421. :    <<--#endif
  422. EOT
  423.         next;
  424.     }
  425.  
  426.     if (/^a/) {
  427.         $appendseen++;
  428.         $command = $space . "\$atext .= <<'End_Of_Text';\n<<--";
  429.         $lastline = 0;
  430.         while (<>) {
  431.         s/^[ \t]*//;
  432.         s/^[\\]//;
  433.         unless (s|\\$||) { $lastline = 1;}
  434.         s/^([ \t]*\n)/<><>$1/;
  435.         $command .= $_;
  436.         $command .= '<<--';
  437.         last if $lastline;
  438.         }
  439.         $_ = $command . "End_Of_Text";
  440.         last;
  441.     }
  442.  
  443.     if (/^[ic]/) {
  444.         if (/^c/) { $change = 1; }
  445.         $addr1 = 1 if $addr1 eq '';
  446.         $addr1 = '$iter = (' . $addr1 . ')';
  447.         $command = $space .
  448.           "    if (\$iter == 1) { print <<'End_Of_Text'; }\n<<--";
  449.         $lastline = 0;
  450.         while (<>) {
  451.         s/^[ \t]*//;
  452.         s/^[\\]//;
  453.         unless (s/\\$//) { $lastline = 1;}
  454.         s/'/\\'/g;
  455.         s/^([ \t]*\n)/<><>$1/;
  456.         $command .= $_;
  457.         $command .= '<<--';
  458.         last if $lastline;
  459.         }
  460.         $_ = $command . "End_Of_Text";
  461.         if ($change) {
  462.         $dseen++;
  463.         $change = "$_\n";
  464.         chop($_ = &q(<<"EOT"));
  465. :    <<--#ifdef PRINTIT
  466. :    $space\$printit = 0;
  467. :    <<--#endif
  468. :    ${space}next LINE;
  469. EOT
  470.         $sawnext++;
  471.         }
  472.         last;
  473.     }
  474.  
  475.     if (/^s/) {
  476.         $delim = substr($_,1,1);
  477.         $len = length($_);
  478.         $repl = $end = 0;
  479.         $inbracket = 0;
  480.         for ($i = 2; $i < $len; $i++) {
  481.         $c = substr($_,$i,1);
  482.         if ($c eq $delim) {
  483.             if ($inbracket) {
  484.             substr($_, $i, 0) = '\\';
  485.             $i++;
  486.             $len++;
  487.             }
  488.             else {
  489.             if ($repl) {
  490.                 $end = $i;
  491.                 last;
  492.             } else {
  493.                 $repl = $i;
  494.             }
  495.             }
  496.         }
  497.         elsif ($c eq '\\') {
  498.             $i++;
  499.             if ($i >= $len) {
  500.             $_ .= 'n';
  501.             $_ .= <>;
  502.             $len = length($_);
  503.             $_ = substr($_,0,--$len);
  504.             }
  505.             elsif (substr($_,$i,1) =~ /^[n]$/) {
  506.             ;
  507.             }
  508.             elsif (!$repl &&
  509.               substr($_,$i,1) =~ /^[(){}\w]$/) {
  510.             $i--;
  511.             $len--;
  512.             substr($_, $i, 1) = '';
  513.             }
  514.             elsif (!$repl &&
  515.               substr($_,$i,1) =~ /^[<>]$/) {
  516.             substr($_,$i,1) = 'b';
  517.             }
  518.             elsif ($repl && substr($_,$i,1) =~ /^\d$/) {
  519.             substr($_,$i-1,1) = '$';
  520.             }
  521.         }
  522.         elsif ($c eq '&' && $repl) {
  523.             substr($_, $i, 0) = '$';
  524.             $i++;
  525.             $len++;
  526.         }
  527.         elsif ($c eq '$' && $repl) {
  528.             substr($_, $i, 0) = '\\';
  529.             $i++;
  530.             $len++;
  531.         }
  532.         elsif ($c eq '[' && !$repl) {
  533.             $i++ if substr($_,$i,1) eq '^';
  534.             $i++ if substr($_,$i,1) eq ']';
  535.             $inbracket = 1;
  536.         }
  537.         elsif ($c eq ']') {
  538.             $inbracket = 0;
  539.         }
  540.         elsif ($c eq "\t") {
  541.             substr($_, $i, 1) = '\\t';
  542.             $i++;
  543.             $len++;
  544.         }
  545.         elsif (!$repl && index("()+",$c) >= 0) {
  546.             substr($_, $i, 0) = '\\';
  547.             $i++;
  548.             $len++;
  549.         }
  550.         }
  551.         &Die("Malformed substitution at line $.\n")
  552.           unless $end;
  553.         $pat = substr($_, 0, $repl + 1);
  554.         $repl = substr($_, $repl+1, $end-$repl-1);
  555.         $end = substr($_, $end + 1, 1000);
  556.         &simplify($pat);
  557.         $subst = "$pat$repl$delim";
  558.         $cmd = '';
  559.         while ($end) {
  560.         if ($end =~ s/^g//) {
  561.             $subst .= 'g';
  562.             next;
  563.         }
  564.         if ($end =~ s/^p//) {
  565.             $cmd .= ' && (print)';
  566.             next;
  567.         }
  568.         if ($end =~ s/^w[ \t]*//) {
  569.             $fh = &make_filehandle($end);
  570.             $cmd .= " && (print $fh \$_)";
  571.             $end = '';
  572.             next;
  573.         }
  574.         &Die("Unrecognized substitution command".
  575.           "($end) at line $.\n");
  576.         }
  577.         chop ($_ = &q(<<"EOT"));
  578. :    <<--#ifdef TSEEN
  579. :    $subst && \$tflag++$cmd;
  580. :    <<--#else
  581. :    $subst$cmd;
  582. :    <<--#endif
  583. EOT
  584.         next;
  585.     }
  586.  
  587.     if (/^p/) {
  588.         $_ = 'print;';
  589.         next;
  590.     }
  591.  
  592.     if (/^w/) {
  593.         s/^w[ \t]*//;
  594.         $fh = &make_filehandle($_);
  595.         $_ = "print $fh \$_;";
  596.         next;
  597.     }
  598.  
  599.     if (/^r/) {
  600.         $appendseen++;
  601.         s/^r[ \t]*//;
  602.         $file = $_;
  603.         $_ = "\$atext .= `cat $file 2>/dev/null`;";
  604.         next;
  605.     }
  606.  
  607.     if (/^P/) {
  608.         $_ = 'print $1 if /^(.*)/;';
  609.         next;
  610.     }
  611.  
  612.     if (/^D/) {
  613.         chop($_ = &q(<<'EOT'));
  614. :    s/^.*\n?//;
  615. :    redo LINE if $_;
  616. :    next LINE;
  617. EOT
  618.         $sawnext++;
  619.         next;
  620.     }
  621.  
  622.     if (/^N/) {
  623.         chop($_ = &q(<<'EOT'));
  624. :    $_ .= "\n";
  625. :    $len1 = length;
  626. :    $_ .= <>;
  627. :    chop if $len1 < length;
  628. :    <<--#ifdef TSEEN
  629. :    $tflag = 0;
  630. :    <<--#endif
  631. EOT
  632.         next;
  633.     }
  634.  
  635.     if (/^h/) {
  636.         $_ = '$hold = $_;';
  637.         next;
  638.     }
  639.  
  640.     if (/^H/) {
  641.         $_ = '$hold .= "\n", $hold .= $_;';
  642.         next;
  643.     }
  644.  
  645.     if (/^g/) {
  646.         $_ = '$_ = $hold;';
  647.         next;
  648.     }
  649.  
  650.     if (/^G/) {
  651.         $_ = '$_ .= "\n", $_ .= $hold;';
  652.         next;
  653.     }
  654.  
  655.     if (/^x/) {
  656.         $_ = '($_, $hold) = ($hold, $_);';
  657.         next;
  658.     }
  659.  
  660.     if (/^b$/) {
  661.         $_ = 'next LINE;';
  662.         $sawnext++;
  663.         next;
  664.     }
  665.  
  666.     if (/^b/) {
  667.         s/^b[ \t]*//;
  668.         $lab = &make_label($_);
  669.         if ($lab eq $toplabel) {
  670.         $_ = 'redo LINE;';
  671.         } else {
  672.         $_ = "goto $lab;";
  673.         }
  674.         next;
  675.     }
  676.  
  677.     if (/^t$/) {
  678.         $_ = 'next LINE if $tflag;';
  679.         $sawnext++;
  680.         $tseen++;
  681.         next;
  682.     }
  683.  
  684.     if (/^t/) {
  685.         s/^t[ \t]*//;
  686.         $lab = &make_label($_);
  687.         $_ = q/if ($tflag) {$tflag = 0; /;
  688.         if ($lab eq $toplabel) {
  689.         $_ .= 'redo LINE;}';
  690.         } else {
  691.         $_ .= "goto $lab;}";
  692.         }
  693.         $tseen++;
  694.         next;
  695.     }
  696.  
  697.     if (/^y/) {
  698.         s/abcdefghijklmnopqrstuvwxyz/a-z/g;
  699.         s/ABCDEFGHIJKLMNOPQRSTUVWXYZ/A-Z/g;
  700.         s/abcdef/a-f/g;
  701.         s/ABCDEF/A-F/g;
  702.         s/0123456789/0-9/g;
  703.         s/01234567/0-7/g;
  704.         $_ .= ';';
  705.     }
  706.  
  707.     if (/^=/) {
  708.         $_ = 'print $.;';
  709.         next;
  710.     }
  711.  
  712.     if (/^q/) {
  713.         chop($_ = &q(<<'EOT'));
  714. :    close(ARGV);
  715. :    @ARGV = ();
  716. :    next LINE;
  717. EOT
  718.         $sawnext++;
  719.         next;
  720.     }
  721.     } continue {
  722.     if ($space) {
  723.         s/^/$space/;
  724.         s/(\n)(.)/$1$space$2/g;
  725.     }
  726.     last;
  727.     }
  728.     $_;
  729. }
  730.  
  731. sub fetchpat {
  732.     local($outer) = @_;
  733.     local($addr) = $outer;
  734.     local($inbracket);
  735.     local($prefix,$delim,$ch);
  736.  
  737.     # Process pattern one potential delimiter at a time.
  738.  
  739.     DELIM: while (s#^([^\]+(|)[\\/]*)([]+(|)[\\/])##) {
  740.     $prefix = $1;
  741.     $delim = $2;
  742.     if ($delim eq '\\') {
  743.         s/(.)//;
  744.         $ch = $1;
  745.         $delim = '' if $ch =~ /^[(){}A-Za-mo-z]$/;
  746.         $ch = 'b' if $ch =~ /^[<>]$/;
  747.         $delim .= $ch;
  748.     }
  749.     elsif ($delim eq '[') {
  750.         $inbracket = 1;
  751.         s/^\^// && ($delim .= '^');
  752.         s/^]// && ($delim .= ']');
  753.     }
  754.     elsif ($delim eq ']') {
  755.         $inbracket = 0;
  756.     }
  757.     elsif ($inbracket || $delim ne $outer) {
  758.         $delim = '\\' . $delim;
  759.     }
  760.     $addr .= $prefix;
  761.     $addr .= $delim;
  762.     if ($delim eq $outer && !$inbracket) {
  763.         last DELIM;
  764.     }
  765.     }
  766.     $addr =~ s/\t/\\t/g;
  767.     &simplify($addr);
  768.     $addr;
  769. }
  770.  
  771. sub q {
  772.     local($string) = @_;
  773.     local($*) = 1;
  774.     $string =~ s/^:\t?//g;
  775.     $string;
  776. }
  777.  
  778. sub simplify {
  779.     $_[0] =~ s/_a-za-z0-9/\\w/ig;
  780.     $_[0] =~ s/a-z_a-z0-9/\\w/ig;
  781.     $_[0] =~ s/a-za-z_0-9/\\w/ig;
  782.     $_[0] =~ s/a-za-z0-9_/\\w/ig;
  783.     $_[0] =~ s/_0-9a-za-z/\\w/ig;
  784.     $_[0] =~ s/0-9_a-za-z/\\w/ig;
  785.     $_[0] =~ s/0-9a-z_a-z/\\w/ig;
  786.     $_[0] =~ s/0-9a-za-z_/\\w/ig;
  787.     $_[0] =~ s/\[\\w\]/\\w/g;
  788.     $_[0] =~ s/\[^\\w\]/\\W/g;
  789.     $_[0] =~ s/\[0-9\]/\\d/g;
  790.     $_[0] =~ s/\[^0-9\]/\\D/g;
  791.     $_[0] =~ s/\\d\\d\*/\\d+/g;
  792.     $_[0] =~ s/\\D\\D\*/\\D+/g;
  793.     $_[0] =~ s/\\w\\w\*/\\w+/g;
  794.     $_[0] =~ s/\\t\\t\*/\\t+/g;
  795.     $_[0] =~ s/(\[.[^]]*\])\1\*/$1+/g;
  796.     $_[0] =~ s/([\w\s!@#%^&-=,:;'"])\1\*/$1+/g;
  797. }
  798.  
  799. sub skip {
  800.     local($level) = 0;
  801.  
  802.     while(<BODY>) {
  803.     /^#ifdef/ && $level++;
  804.     /^#else/  && !$level && return;
  805.     /^#endif/ && !$level-- && return;
  806.     }
  807.  
  808.     die "Unterminated `#ifdef' conditional\n";
  809. }
  810.